home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / xlib / yicons24 / source / stars.prj < prev    next >
Text File  |  1993-03-05  |  7KB  |  284 lines
  1.  := 0;
  2.       end;
  3.     end;
  4.   end;
  5.   WaitToGo;
  6. end; { UserLineStylePlay }
  7.  
  8.  
  9. procedure SayGoodbye;
  10. { Say goodbye and then exit the program }
  11. var
  12.   ViewInfo : ViewPortType;
  13. begin
  14.   MainWindow('');
  15.   GetViewSettings(ViewInfo);
  16.   SetTextStyle(TriplexFont, HorizDir, 4);
  17.   SetTextJustify(CenterText, CenterText);
  18.   with ViewInfo do
  19.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'That''s all folks!');
  20.   StatusLine('Press any key to quit...');
  21.   repeat until KeyPressed;
  22. end; { SayGoodbye }
  23.  
  24.  
  25. PROCEDURE SelectMode;
  26. VAR
  27.     choice1,choice2     : CHAR;
  28.    xsize,ysize            : WORD;
  29. BEGIN
  30.     (* Let's select a mode *)
  31.     ClrScr;
  32.     WriteLn('VESADEMO:');
  33.     WriteLn('1. 256 colors');
  34.     WriteLn('2. 32768 colors');
  35.     WriteLn('3. 65536 colors');
  36.     WriteLn('4. 16777216 colors');
  37.     WriteLn('Q uit');
  38.     WriteLn;
  39.     Write('Your choice: ');
  40.     REPEAT
  41.         ReadLn(choice1);
  42.       IF choice1 <> '1' THEN BEGIN
  43.           WriteLn('Sorry !');
  44.          WriteLn('This demo wasn''t written for more as 256 colors !');
  45.          WriteLn('You would only get a limited impression of the Hi-& TrueColor modes...');
  46.          WriteLn('Switching to 256 colors.');
  47.          choice1 := '1';
  48.       END;
  49.     UNTIL choice1 IN ['1'..'4','q'];
  50.     IF choice1 = 'q' THEN Halt;
  51.  
  52.     WriteLn;
  53.     WriteLn;
  54.     WriteLn('a. 320x200');
  55.     WriteLn('b. 640x480');
  56.     WriteLn('c. 800x600');
  57.     WriteLn('d. 1024x768');
  58.     WriteLn('e. 1280x1024');
  59.     WriteLn('Q uit');
  60.     WriteLn;
  61.     Write('Your choice: ');
  62.     REPEAT
  63.         ReadLn(choice2);
  64.     UNTIL choice2 IN ['a'..'e','q'];
  65.     IF choice2 = 'q' THEN Halt;
  66.  
  67.     CASE choice2 OF
  68.         'a' : BEGIN
  69.             xsize := 320;
  70.             ysize := 200;
  71.         END;
  72.         'b' : BEGIN
  73.             xsize := 640;
  74.             ysize := 480;
  75.         END;
  76.         'c' : BEGIN
  77.             xsize := 800;
  78.             ysize := 600;
  79.         END;
  80.         'd' : BEGIN
  81.             xsize := 1024;
  82.             ysize := 768;
  83.         END;
  84.         'e' : BEGIN
  85.             xsize := 1280;
  86.             ysize := 1024;
  87.         END;
  88.     END;
  89.     CASE choice1 OF
  90.         '1' : mode := FindVesaMode(xsize,ysize,8);
  91.         '2' : mode := FindVesaMode(xsize,ysize,15);
  92.         '3' : mode := FindVesaMode(xsize,ysize,16);
  93.         '4' : mode := FindVesaMode(xsize,ysize,24);
  94.     END;
  95.     IF mode = 0 THEN BEGIN
  96.         WriteLn('No such mode could be found !');
  97.         WriteLn('Switching to to 320x200.');
  98.         ReadKey;
  99.         mode := V320x200x256;
  100.     END;
  101. END;
  102.  
  103. begin { program body }
  104.   SelectMode;
  105.   Initialize;
  106.   ReportStatus;
  107.  
  108. {  AspectRatioPlay; }
  109.   FillEllipsePlay;
  110.   SectorPlay;
  111.   WriteModePlay;
  112.  
  113.   ColorPlay;
  114.   { PalettePlay only intended to work on these drivers: }
  115.   if (GraphDriver = EGA) or
  116.       (GraphDriver = EGA64) or
  117.       (GraphDriver = VGA) then
  118.      PalettePlay;
  119.   PutPixelPlay;
  120. {  PutImagePlay; }
  121.   RandBarPlay;
  122.   BarPlay;
  123.   Bar3DPlay;
  124.   ArcPlay;
  125.   CirclePlay;
  126.   PiePlay;
  127.   LineToPlay;
  128.   LineRelPlay;
  129. {  LineStylePlay; }
  130. {  UserLineStylePlay; }
  131.   TextDump;
  132.   TextPlay;
  133.   CrtModePlay;
  134.   FillStylePlay;
  135.   FillPatternPlay;
  136.   PolyPlay;
  137.   SayGoodbye;
  138. {  CloseGraph; }
  139.   CloseVesa;
  140. end.
  141. ***************************************************
  142.     '* SHOW D2ROTATE (ABOUT THE ORIGIN)
  143.     '****************************************************************∞╥≤c≤*φè#^│v/╒:j═φ0t+l▓ô"¬"g└≡?%ªêΣ│H╫½╫╜├¿U'╒⌐⌡ ßV?╩¬ujOΦçEZ1∞▐! ▄B╛Σ8║æ]1GlNÜ┐q▌▓;ô$ΦzE<cª*bEô#ä╧ñÅ"∩─LrdaÖ ╠º╫a^¥£å╬1~)@ëÖMδ╫0═6DäFê¬Çv┼ß╨kæpτ╪É)}ª 1w3╤╧ü⌡¥╓h▓╣≈ïÅaÑ[TⁿHqªÉ╝DKÄ─Y-∞tT╤Θ╨º╟╪.*ÇI9lΦ≈{πτcσ$τπßoFr╪╨∩┼╞╟;O2■e²LÜ4^N|╪½ÅO?╔°FOz`╟╟╟'<>>π$πΘù6·Xgî╖│°oîδπGƒd╝▀░?■╪╔_9L ⌡ôⁿq'æO▀ƒn4╔▀╚▄┼3pτ.òO°·}÷╕ⁿ±'æO?ít│!√8ßÑ≤/┐╣p┼≥┘E╦Vox╕cΦé5╟╚º╙$?√$≥ΘZεsî≡åìΓpKù¢ïß X╥ 9╞≈\µk┤O¥_ 5Üö\≤éÄ┌╤A[╤ÿáï┼éNⁿÅu16    g,%hc╙╨cD╨Vï┘R¢öKñR;8εáΣ╢╪ós╤π╡á└èxgzPÄMú╫yαºÉ+σJ¢i+▓â3╥    ═Ñ╙î^ºG▓█πérφçs %#(╗⌠?┼%u8≡6+QÉ))ò)Afw≈╣╪)B&4░åLXV:δät@Å.;5Φf╢Ät┐ΣJ╫─U8úÇ╟éö£╕p╔┴⌠vg╨╬╥é÷╪╣┬ΓI.ç≡^v╤ZΦÇ& ╒┌6ñô6XßNè╡╬E₧Ñ
  144. kIº╠▄A+╣╥éb²tæ-Y¡½αÑa═uuîÇ╢αêvhuª╡SÅ┤vèùú¥F;p<d⌐/F─d█éT%▓KΦû=q■öI┐ ┐╠6S$▒÷╚ENΩ¥Fû9╔┌R'╝ ╧φ└?g┬j▓0═/b╖₧─mûé╢┌»ÿÄë/·<éò■░╤╟╢├Xσ:╥P3Θ"╬Læsφ░┌öSö!╗¿*mN£WΣÇ£┤~#╗ææ≥RΩóh:à▌.æ≈╕▌v£äàd▒à╒├=░╖π║$howeg*╬    6ù▄ƒô╕φ░Ö╢qΘD>(w@úKεHÆ╛öúΣU
  145. éÜR╔╤W▄èê 2M%ó.▓SNÖA1ùJE╢║l]▓¿>\%└Å4ßO▄£â⌐& ê/)8vSP▀▓ôⁿææ√ü√ÑÄa⌠â╚4S╓╟P- ?Σá╕▓Næ*q╡UΘ▓≈^ñ·I.rúR&$Y^╚%è≡B┌≈Ceat
  146.     Color := RandColor;
  147.     SetColor(Color);
  148.     SetFillStyle(Random(CloseDotFill)+1, Color);
  149.     Bar3D(Random(MaxWidth), Random(MaxHeight),
  150.           Random(MaxWidth), Random(MaxHeight), 0, TopOff);
  151.   until KeyPressed;
  152.   WaitToGo;
  153. end; { RandBarPlay }
  154.  
  155. procedure ArcPlay;
  156. { Draw random arcs on the screen }
  157. var
  158.   MaxRadius : word;
  159.   EndAngle : word;
  160.   ArcInfo : ArcCoordsType;
  161. begin
  162.   MainWindow('Arc / GetArcCoords demonstration');
  163.   StatusLine('Esc aborts or press a key');
  164.   MaxRadius := MaxY div 10;
  165.   repeat
  166.     SetColor(RandColor);
  167.     EndAngle := Random(360);
  168.     SetLineStyle(SolidLn, 0, NormWidth);
  169.     Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius));
  170.     GetArcCoords(ArcInfo);
  171.     with ArcInfo do
  172.     begin
  173.       Line(X, Y, XStart, YStart);
  174.       Line(X, Y, Xend, Yend);
  175.     end;
  176.   until KeyPressed;
  177.   WaitToGo;
  178. end; { ArcPlay }
  179.  
  180. procedure PutPixelPlay;
  181. { Demonstrate the PutPixel and GetPixel commands }
  182. const
  183.   Seed   = 1962; { A seed for the random number generator }
  184.   NumPts = 2000; { The number of pixels plotted }
  185.   Esc    = #27;
  186. var
  187.   I : word;
  188.   X, Y, Color : word;
  189.   XMax, YMax  : integer;
  190.   ViewInfo    : ViewPortType;
  191. begin
  192.   MainWindow('PutPixel / GetPixel demonstration');
  193.   StatusLine('Esc aborts or press a key...');
  194.  
  195.   GetViewSettings(ViewInfo);
  196.   with ViewInfo do
  197.   begin
  198.     XMax := (x2-x1-1);
  199.     YMax := (y2-y1-1);
  200.   end;
  201.  
  202.   while not KeyPressed do
  203.   begin
  204.     { Plot random pixels }
  205.     RandSeed := Seed;
  206.     I := 0;
  207.     while (not KeyPressed) and (I < NumPts) do
  208.     begin
  209.       Inc(I);
  210.         PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor);
  211.     end;
  212.  
  213.     { Erase pixels }
  214.     RandSeed := Seed;
  215.     I := 0;
  216.     while (not KeyPressed) and (I < NumPts) do
  217.     begin
  218.       Inc(I);
  219.       X := Random(XMax)+1;
  220.       Y := Random(YMax)+1;
  221.       Color := GetPixel(X, Y);
  222.         if Color = RandColor then
  223.           PutPixel(X, Y, 0);
  224.      end;
  225.   end;
  226.   WaitToGo;
  227. end; { PutPixelPlay }
  228.  
  229. procedure PutImagePlay;
  230. { Demonstrate the GetImage and PutImage commands }
  231.  
  232. const
  233.   r  = 20;
  234.   StartX = 100;
  235.   StartY = 50;
  236.  
  237. var
  238.   CurPort : ViewPortType;
  239.  
  240. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  241. var
  242.   Step : integer;
  243. begin
  244.   Step := Random(2*r);
  245.   if Odd(Step) then
  246.     Step := -Step;
  247.   X := X + Step;
  248.   Step := Random(r);
  249.   if Odd(Step) then
  250.     Step := -Step;
  251.   Y := Y + Step;
  252.  
  253.   { Make saucer bounce off viewport walls }
  254.   with CurPort do
  255.   begin
  256.     if (x1 + X + Width - 1 > x2) then
  257.       X := x2-x1 - Width + 1
  258.     else
  259.       if (X < 0) then
  260.         X := 0;
  261.     if (y1 + Y + Height - 1 > y2) then
  262.       Y := y2-y1 - Height + 1
  263.     else
  264.       if (Y < 0) then
  265.         Y := 0;
  266.   end;
  267. end; { MoveSaucer }
  268.  
  269. var
  270.   Pausetime : word;
  271.   Saucer    : pointer;
  272.   X, Y      : integer;
  273.   ulx, uly  : word;
  274.   lrx, lry  : word;
  275.   Size      : word;
  276.   I         : word;
  277. begin
  278.   ClearDevice;
  279.   FullPort;
  280.  
  281.   { PaintScreen }
  282.   ClearDevice;
  283.   MainWindow('GetImage / PutImage Demonstration');
  284.   StatusLin